unit Form1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtDlgs, MaskEdit, ComCtrls, Windows, Registry, IniFiles, Process,
  LCLIntf, LMessages, ExtCtrls, Buttons,
  { Other units }
  CSVDocument, FileInfo, WinPEImageReader, RegExpr,
  { User units }
  Utils, Form2, Form3;

const
  UM_DOSOMEWORK = LM_USER + 1;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    CalcDlg: TCalculatorDialog;
    CalDlg: TCalendarDialog;
    FlowPanel1: TFlowPanel;
    FlowPanel2: TFlowPanel;
    Memo2: TMemo;
    StatusLabel: TEdit;
    Memo1: TMemo;
    TaskDlg: TTaskDialog;
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure StatusLabelMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure StatusLabelMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure Log(const s: string);
  private
    procedure AsyncProc(Data: PtrInt);
    procedure OnUserMessage(var msg: TLMessage); message UM_DOSOMEWORK;
  public
    procedure SetStatus(s: string);
  end;

  AsyncCallRecord = record
    timestamp: TDateTime;
    tag: string;
  end;
  AsyncCallRecordPtr = ^AsyncCallRecord;

var
  oForm1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.SetStatus(s: string);
begin
  self.StatusLabel.Text := s;
end;

procedure TForm1.Log(const s: string);
begin
  self.Memo2.Lines.Add(s);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  fvi: TFileVersionInfo;
  sz: array[1..MAX_PATH] of char;
begin
  self.Caption := 'FPC version ' + {$I %FPCVERSION%};
  Log(Format('RegExpr v%d.%d', [TRegExpr.VersionMajor, TRegExpr.VersionMinor]));

  ExpandEnvironmentStrings('%windir%\system32\shlwapi.dll', @sz, MAX_PATH);
  fvi := TFileVersionInfo.Create(nil);
  try
    fvi.FileName := strpas(@sz);
    Log(fvi.FileName);
    fvi.ReadFileInfo;
    Log(fvi.VersionStrings.Values['FileVersion']);
  finally
    fvi.Free;
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Memo1.Width := (self.Width - Memo1.Left * 3) div 2;
  Memo2.Left := Memo1.Left + Memo1.Width + Memo1.Left;
  Memo2.Width := Memo1.Width;
end;

procedure TForm1.StatusLabelMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  StatusLabel.BeginDrag(False);
end;

procedure TForm1.StatusLabelMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  StatusLabel.EndDrag(True);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if self.TaskDlg.Execute(self.Handle) then
    Memo1.Text := Format('Button #%d clicked', [self.TaskDlg.ModalResult])
  else
    Memo1.Text := 'Dialog failed';
end;

procedure TForm1.Button10Click(Sender: TObject);
var
  l: TStringList;
begin
  try
    l := TStringList.Create;
    l.LoadFromFile('not a file');
  except
    on ex: Exception do
    begin
      //Application.ShowException(ex);
      MessageDlg('Error', ex.Message, TMsgDlgType.mtError, [mbOK], 0);
    end;
  end;
end;

procedure TForm1.Button11Click(Sender: TObject);
var
  s1, s2: string;
  i: integer;
begin
  s1 := Memo1.Lines[0];
  s2 := Memo1.Lines[1];
  i := lstrcmpi(PChar(s1), PChar(s2));
  SetStatus(Format('lstrcmpi result: %d', [i]));
end;

procedure TForm1.Button12Click(Sender: TObject);
var
  f: TForm2;
begin
  Application.CreateForm(TForm2, f);
  f.ShowInTaskBar := TShowInTaskbar.stDefault;
  f.Show;
end;

procedure TForm1.Button13Click(Sender: TObject);
var
  f: TForm3;
begin
  Application.CreateForm(TForm3, f);
  f.ShowInTaskBar := TShowInTaskbar.stDefault;
  f.Show;
end;

procedure TForm1.Button14Click(Sender: TObject);
var
  pattern: TRegExpr;
  line: string;
  i: integer;
begin
  pattern := TRegExpr.Create('^\s*(\S+|".+?")\s*:\s*(\d*\.\d+|\d+\.?)(?:\s+(.*))?');
  Memo2.Clear;
  for line in Memo1.Lines do
  begin
    if pattern.Exec(line) then
    begin
      Memo2.Lines.Add(Format('%d match(es)', [pattern.SubExprMatchCount]));
      for i := 0 to pattern.SubExprMatchCount do
      begin
        Memo2.Lines.Add(Format('[%d]=%s', [i, pattern.Match[i]]));
      end;
      Memo2.Lines.Add('================');
    end;
  end;
  pattern.Free;
end;

procedure TForm1.Button15Click(Sender: TObject);
var
  doc: TCSVDocument;
  ms: TMemoryStream;
  s: string;
begin
  ms := TMemoryStream.Create;
  doc := TCSVDocument.Create;
  doc.Cells[0, 0] := 'first';
  doc.Cells[1, 0] := 'with , comma';
  doc.Cells[0, 1] := 'second line';
  doc.Cells[1, 1] := '"abc def"';

  try
    try
      doc.SaveToStream(ms);
      SetString(s, PAnsiChar(ms.Memory), ms.Size);
      Memo2.Text := s;
    except
      on ex: Exception do
      begin
        MessageDlg('Error', ex.Message, TMsgDlgType.mtError, [mbOK], 0);
        exit;
      end;
    end
  finally
    doc.Free;
    ms.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if self.CalDlg.Execute then
    Memo1.Text := DateTimeToStr(self.CalDlg.Date)
  else
    Memo1.Text := 'Cancelled';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  self.CalcDlg.Execute;
  with Memo1 do
  begin
    Text := floattostr(self.CalcDlg.Value);
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  rc: integer;
  s1, s2: string;
begin
  s1 := Memo1.Lines.ValueFromIndex[0];
  s2 := Memo1.Lines.ValueFromIndex[1];
  rc := CompareString(LOCALE_USER_DEFAULT, 0, PChar(s1), -1, PChar(s2), -1);
  case rc of
    1: SetStatus('<');
    2: SetStatus('=');
    3: SetStatus('>');
    else
      SetStatus(Format('GetLastError=%u', [GetLastError()]));
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  some: TSome;
begin
  some := TSome.Create;
  SetStatus(Utils.Name);
  FreeAndNil(some);
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.OpenKeyReadOnly('Software\neo_in_matrix@msn.com\Bing Daily Wallpaper');
  SetStatus('Folder: ' + reg.ReadString('Folder'));
  FreeAndNil(reg);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  ini: TMemIniFile;
begin
  try
    try
      ini := TMemIniFile.Create('c:\temp\test.ini');
      self.Memo1.Lines.Add(ini.ReadString('main', 'now', '<none>'));
      ini.WriteString('main', 'now', datetimetostr(now));
      ini.UpdateFile;
    except
      on ex: Exception do SetStatus(ex.ToString);
    end
  finally
    FreeAndNil(ini);
  end;
end;

procedure TForm1.AsyncProc(Data: PtrInt);
var
  asyncdata: AsyncCallRecordPtr;
begin
  asyncdata := {%H-}AsyncCallRecordPtr(Data);
  self.Log(Format('%s @%s', [asyncdata^.tag, datetimetostr(asyncdata^.timestamp)]));
  Dispose(asyncdata);
end;

procedure TForm1.OnUserMessage(var msg: TLMessage);
begin
  self.Log(Format('User message %u w=%u l=%u', [msg.msg, msg.wParam, msg.lParam]));
end;

function WorkerProc(Data: pointer): PtrInt;
var
  this: TForm1;
  asyncdata: AsyncCallRecordPtr;
begin
  Result := 0;
  this := TForm1(Data);
  asyncdata := new(AsyncCallRecordPtr);
  asyncdata^.tag := 'Async call from worker proc';
  asyncdata^.timestamp := now;
  Application.QueueAsyncCall(@this.AsyncProc, {%H-}PtrInt(asyncdata));
  PostMessage(this.Handle, UM_DOSOMEWORK, 12345, 567890);
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  CloseThread(self.Tag);
  self.Tag := BeginThread(@WorkerProc, self);
end;

procedure TForm1.Button9Click(Sender: TObject);
var
  proc: TProcess;
begin
  proc := TProcess.Create(self);
  proc.Executable := 'notepad';
  proc.Parameters.Add('some');
  proc.Execute;
  proc.Free;
end;

end.
